should probably explain in detail how the input functons work in general (Arguments, etc)
ui_textInputs = page_fluid(
textInput(inputId = "text_box", label = "Experiment name:"),
textAreaInput(inputId = "big_text_box", "Describe your experiment:", rows = 3)
)ui_selInputs <- page_fluid(
selectInput("dropdown", "Select a gene:",
choices = c("TP53", "PTEN", "HRAS", "PI3K")),
selectInput("dropdown", "Select a gene from this really wide box!",
choices = c("TP53", "PTEN", "HRAS", "PI3K"),
width = "100%"),
selectInput("dropdown2", "Select more than one gene if you want:",
choices = c("TP53", "PTEN", "HRAS", "PI3K"),
selected = c("PTEN", "HRAS"), multiple = T),
)ui_pickInputs <- page_fluid(
"If you want the user to only select one option from a list, radioButtons work well",
radioButtons("radio", "Select only one gene from the radio selections:",
choices = c("TP53", "PTEN", "HRAS", "PI3K"),
selected = "HRAS"),
"To allow the user to select multiple options, use checkboxGroupInput",
checkboxGroupInput("checkbox_group", "Check one or more boxes next to a gene:",
choices = c("TP53", "PTEN", "HRAS", "PI3K")),
"OR if you only want a binary yes/no, you can use checkboxInput",
checkboxInput("checkbox", "Do you agree to the terms and conditions?"),
)We have seen many types of inputs, but these would be pointless if we can’t detect when they change or know what is selected.
Every input returns some kind of value, and changes in this value can be recorded by shiny. This introduces the concept of ‘reactivity’, the key element of shiny that makes apps useful and cool.
If we include an output and it’s corresponding render function that uses inputs we have created, we can see the return value of the input.
This is an example of simple reactivity, we change the gene, and the gene_name output detects this and displays the new gene name.
Inputs are considered a ‘reactive value’. This means that when that value changes, anything that relies on this value will also change.
The requires special handling, and a reactive value can only be used in certain contexts. For example, we get an error if we just try and print input$gene without putting it inside a reactive handler, such as renderText.
We will learn more about other reactive contexts later on.
Here is a slightly more complicated reactive situation where we have more than one input being used by an output, including a calculation involving two separate inputs.
ui_gene2 <- page_fluid(
radioButtons("gene", "Select only one gene from the radio selections:",
choices = c("TP53", "PTEN", "HRAS", "PI3K"),
selected = "HRAS"),
sliderInput("conditions", "Number of samples", value = 10, min = 0, max = 25),
numericInput("replicates", "Number of replicates", value = 1, min = 0, max = 100),
textOutput("study_summary")
)
server_gene2 = function(input, output){
output$study_summary <- renderText({
paste0("We will study ", input$gene, " and use ", input$conditions, " samples, with ", input$replicates, " replicates of each. This will give ", input$conditions*input$replicates, " total samples.")
})
}This sets up a reactive graph where we have one output, output$study_summary, that depends on three inputs and a separate calculation that involves the two numeric inputs.
While this code will work, it is not the most efficient way to write this app. Because output\(study_summary* depends directly on the sample calculation, it will re-run it any time that **any one of these inputs change**, even if it is not involved in that calculation, such as *input\)gene.
This is okay for this situation, but if a more intensive calculation was being done, this would slow the app considerably.
A key aspect of reactivity in Shiny is that evaluation in a shiny app is generally ‘lazy’. This means that any code in the app is only evaluated when it is needed, typically when a dependency changes. This is different than a typical R script that runs from top to bottom.
We will introduce a new shiny function that helps to make reactivity much more efficient and utilizes the advantage of lazy code evaluation in shiny.
That would be the reactive function, which creates a reactive expression. A reactive expression usually takes inputs as dependencies and it’s value is often used by an output.
Key aspects of a reactive function:
A reactive function takes a chunk of R code and returns a value like a regular R function. To use the result, use the name of the expression followed by parenthesis, e.g. total_samples() below. It will return the object made by the last line, or you can use the return function, just like any other function in R.
server_geneGood = function(input, output){
total_samples <- reactive({
input$conditions*input$replicates
})
output$study_summary <- renderText({
paste0("We will study ", input$gene, " and use ", input$conditions, " samples, with ", input$replicates, " replicates of each. This will give ", total_samples(), " total samples.")
})
}Applied to our previous example, output$study_summary calls total_samples(), which takes dependencies on the two numeric inputs to make this calculation.
total_samples() is only calculated if input\(conditions* or *input\)replicates has changed since the last time this text was rendered.
If the input$gene is changed, then the cached value of total_samples() is used and it does not need to be re-calculated.
As a reminder, when this calculation was previously housed within the renderText function and not in a reactive expression, the total number of samples would be recalculated if input$gene changed, even though the calculation doesn’t depend on it.
We will eventually add reactivity to our RNAseq analysis app, which currently displays some nice information, but does not respoind to the user in any way (current app is below).
We will go through some useful modifications with small example apps before adding them to the app we built in Session 1.

We can add numeric inputs for the user to add cutoff values for adjusted pvalue and log2 fold change.
Here we use those input values from the user and filter the table:
ui_filter <- page_fluid(
numericInput("padj_filter", label = "Cutoff for padj:", value = 0.05, min = 0, max = 1, step = 0.005), #<<
numericInput("lfc_filter", label = "Cutoff for log2 FC:", value = 0, min = 0, step = 0.1), #<<
dataTableOutput(outputId = "de_data")
)
server_filter = function(input, output){
filtered_de <- reactive(de_table %>% dplyr::filter(padj < input$padj_filter & abs(log2FoldChange) > input$lfc_filter))
output$de_data = renderDataTable(datatable(filtered_de()))
}In the server function we will add a reactive expression that will take these values and make a filtered version of the differential expression table.
We then use this table in the renderDataTable function where we render the table.
ui_filter <- page_fluid(
numericInput("padj_filter", label = "Cutoff for padj:", value = 0.05, min = 0, max = 1, step = 0.005),
numericInput("lfc_filter", label = "Cutoff for log2 FC:", value = 0, min = 0, step = 0.1),
dataTableOutput(outputId = "de_data")
)
server_filter = function(input, output){
filtered_de <- reactive(de_table %>% dplyr::filter(padj < input$padj_filter & abs(log2FoldChange) > input$lfc_filter)) #<<
output$de_data = renderDataTable(datatable(filtered_de())) #<<
}Value boxes can be a nice way to let the user know of important numbers that are changing. Here we add textOutput function calls to the ‘value’ argument to dynamically sense when the user changes the pdj or log2FC inputs.
This will be paired with a renderText function in the server to use the inputs.
ui_filter_value <- page_fluid(
numericInput("padj_filter", label = "Cutoff for padj:", value = 0.05, min = 0, max = 1, step = 0.005),
numericInput("lfc_filter", label = "Cutoff for log2 FC:", value = 0, min = 0, step = 0.1),
layout_columns(
value_box(title = "Number of genes that go up:", value = textOutput("num_up"), showcase = icon("arrow-up"), theme = value_box_theme(bg = "#22b430")), #<<
value_box(title = "Number of genes that go down:", value = textOutput("num_down"), showcase = icon("arrow-down"), theme = value_box_theme(bg ="#c34020" )), #<<
col_widths = c(2,2)))
server_filter_value = function(input, output){
filtered_de <- reactive(de_table %>% dplyr::filter(padj < input$padj_filter & abs(log2FoldChange) > input$lfc_filter))
num_up_genes <- reactive(filtered_de() %>% dplyr::filter(log2FoldChange > 0 & padj < 0.05) %>% nrow)
num_down_genes <- reactive(filtered_de() %>% dplyr::filter(log2FoldChange < 0 & padj < 0.05) %>% nrow)
output$num_up <- renderText(num_up_genes())
output$num_down <- renderText(num_down_genes())
}In the server we make reactives that return the number of genes that go up or down, and these reactives are used by renderText, which is paired with the textOutput in the UI.
These reactives contain both the padj and log2 fold change inputs, so whenever these inputs are modified, the reactive and the value displayed in the value box will change.
ui_filter_value <- page_fluid(
numericInput("padj_filter", label = "Cutoff for padj:", value = 0.05, min = 0, max = 1, step = 0.005),
numericInput("lfc_filter", label = "Cutoff for log2 FC:", value = 0, min = 0, step = 0.1),
layout_columns(
value_box(title = "Number of genes that go up:", value = textOutput("num_up"), showcase = icon("arrow-up"), theme = value_box_theme(bg = "#22b430")),
value_box(title = "Number of genes that go down:", value = textOutput("num_down"), showcase = icon("arrow-down"), theme = value_box_theme(bg ="#c34020" )),
col_widths = c(2,2)))
server_filter_value = function(input, output){
filtered_de <- reactive(de_table %>% dplyr::filter(padj < input$padj_filter & abs(log2FoldChange) > input$lfc_filter))
num_up_genes <- reactive(filtered_de() %>% dplyr::filter(log2FoldChange > 0 & padj < 0.05) %>% nrow) #<<
num_down_genes <- reactive(filtered_de() %>% dplyr::filter(log2FoldChange < 0 & padj < 0.05) %>% nrow) #<<
output$num_up <- renderText(num_up_genes()) #<<
output$num_down <- renderText(num_down_genes()) #<<
}In the app, we see that the numbers in the box react when we change the log2FC input.

Now we have two tables, filtered and unfiltered. Which do we show to the user? both? Both might be overwhelming, but the user might want access the whole dataset after filtering. Oftentimes having multiple tabs within a card can be a nice clean way to do this.
To do this, we change the card that we want to contain tabs to use the function navset_card_tab. This works just like the page_navbar function, where multiple nav_panel function calls within navset_card_tab results in individual tabs.
There are a few other options for how the tabs will look, outlined here.

In the UI, the navset_card_tab function is added with two nav_panel objects, one for the full data set and one for the fitlered data. We then need to add a corresponding render function for the second tab containing the full table.
ui_tab <- page_fluid(theme = custom_theme,
numericInput("padj_filter", label = "Cutoff for padj:", value = 0.05, min = 0, max = 1, step = 0.005),
numericInput("lfc_filter", label = "Cutoff for log2 FC:", value = 0, min = 0, step = 0.1),
actionButton("de_filter", "Apply filter"),
navset_card_tab(title = "DE result tables", height = "750px", #<<
nav_panel(card_header("DEGs"), dataTableOutput(outputId = "de_data")), #<<
nav_panel(card_header("All genes"), dataTableOutput(outputId = "all_data"))), #<<
)
server_tab = function(input, output){
output$all_data = renderDataTable(datatable(de_table)) #<<
filtered_de <- reactive(de_table %>% dplyr::filter(padj < input$padj_filter & abs(log2FoldChange) > input$lfc_filter)) %>%
bindEvent(input$de_filter, ignoreNULL = FALSE)
output$de_data = renderDataTable(datatable(filtered_de()))
}We can also make the plots responsive to the cutoffs by coloring the points that exceed the thresholds.
Most of the work here will be done with server logic, but in the simple app below we include the filters, a button, and MA plot to the UI object.
ui_colorDE <- page_fluid(theme = custom_theme,
numericInput("padj_filter", label = "Cutoff for padj:", value = 0.05, min = 0, max = 1, step = 0.005),
numericInput("lfc_filter", label = "Cutoff for log2 FC:", value = 0, min = 0, step = 0.1),
actionButton("de_filter", "Apply filter"),
card(card_header("MA plot"), plotOutput("ma_plot")) #<<
)server_colorDE = function(input, output){
ma_plot_reac <- reactive({ #<<
de_table %>% #<<
dplyr::mutate(sig = ifelse(padj < input$padj_filter & abs(log2FoldChange) > input$lfc_filter, "DE", "Not_DE")) %>% #<<
ggplot(aes(x = baseMean, y = log2FoldChange, color = sig)) + geom_point() + scale_x_log10() + #<<
scale_color_manual(name = "DE status", values = c("red", "grey")) + #<<
xlab("baseMean (log scale)") + theme_bw() #<<
}) %>%
bindEvent(input$de_filter, ignoreNULL = FALSE)
output$ma_plot = renderPlot(ma_plot_reac())
}server_colorDE = function(input, output){
ma_plot_reac <- reactive({
de_table %>%
dplyr::mutate(sig = ifelse(padj < input$padj_filter & abs(log2FoldChange) > input$lfc_filter, "DE", "Not_DE")) %>%
ggplot(aes(x = baseMean, y = log2FoldChange, color = sig)) + geom_point() + scale_x_log10() +
scale_color_manual(name = "DE status", values = c("red", "grey")) + #
xlab("baseMean (log scale)") + theme_bw()
}) %>%
bindEvent(input$de_filter, ignoreNULL = FALSE) #<<
output$ma_plot = renderPlot(ma_plot_reac())
}server_colorDE = function(input, output){
ma_plot_reac <- reactive({ #<<
de_table %>%
dplyr::mutate(sig = ifelse(padj < input$padj_filter & abs(log2FoldChange) > input$lfc_filter, "DE", "Not_DE")) %>%
ggplot(aes(x = baseMean, y = log2FoldChange, color = sig)) + geom_point() + scale_x_log10() +
scale_color_manual(name = "DE status", values = c("red", "grey")) +
xlab("baseMean (log scale)") + theme_bw()
}) %>%
bindEvent(input$de_filter, ignoreNULL = FALSE)
output$ma_plot = renderPlot(ma_plot_reac()) #<<
}Now we can use some of these inputs and reactivity to improve our RNAseq analysis app. As a reminder, below is the UI of the app we left off with.
In the app we built in Session 1, we have a blank sidebar and this would be a good place to add the pvalue and log2FC filters that the tables and plots will depend on.

Recap of changes to UI: * In the sidebar, add inputs for padj and log2FC filter values and the button to control when those changes happen * Make a navset_card_tab that will have two tabs, one for the filtered data based on the user inputs and another showing the entire data set.
ui_filterMain <- page_navbar(
title = "RNAseq tools",
theme = custom_theme,
nav_panel(
title = "DE Analysis",
layout_sidebar(
sidebar = sidebar(
width = 300,
numericInput("padj_filter", label = "Cutoff for padj:", value = 0.05, min = 0, max = 1, step = 0.005), # >>>>>>>>>>>>>>>
numericInput("lfc_filter", label = "Cutoff for log2 FC:", value = 1, min = 0, step = 0.1), # >>>>>>>>>>>>>>>
actionButton("de_filter", "Apply filter") # >>>>>>>>>>>>>>>
),
layout_columns(
navset_card_tab( # >>>>>>>>>>>>>>>
title = "DE result tables",
nav_panel(card_header("DEGs"), dataTableOutput(outputId = "de_data")), # >>>>>>>>>>>>>>>
nav_panel(card_header("All genes"), dataTableOutput(outputId = "all_data")) # >>>>>>>>>>>>>>>
),
card(card_header("MA plot"),plotOutput("ma_plot")),
card(card_header("Volcano plot"),plotOutput("volcano_plot")),
col_widths = c(12,6,6), row_heights = c("750px", "500px")
)
)
),
nav_panel(
title = "Next steps",
"The next step in our analysis will be..."
),
nav_spacer(),
nav_menu(
title = "Links",
align = "right",
nav_item(
tags$a(
shiny::icon("chart-simple"), "RU BRC - Learn more!",
href = "https://rockefelleruniversity.github.io/",
target = "_blank"
)
)
)
)Recap of changes to server: * Add a reactive expression that returns the filtered table and then use that table as an output in the renderDataTable function. * Add an output and renderDataTable function for the whole data set. * Convert the ggplot objects into reactive expressions and add a column to the data indicating whether a gene should be colored as passing filters from user. These reactives are used in the renderPlot functions. * Add bindEvent function calls to the filtered table and ggplot reative expressions so they will update when the user changes the filters.
server_filterMain = function(input, output) {
output$all_data = renderDataTable({ # >>>>>>>>>>>>>>>
datatable(de_table,
selection = "none",
filter = 'top') %>%
formatRound(columns = c("baseMean", "log2FoldChange", "lfcSE", "stat"), digits = 3) %>%
formatSignif(columns = c("pvalue", "padj"), digits = 3)
})
filtered_de <- reactive({
de_table %>%
dplyr::filter(padj < input$padj_filter & abs(log2FoldChange) > input$lfc_filter) # >>>>>>>>>>>>>>>
}) %>%
bindEvent(input$de_filter, ignoreNULL = FALSE) # >>>>>>>>>>>>>>>
output$de_data = renderDataTable({
datatable(filtered_de(), # >>>>>>>>>>>>>>>
selection = "none",
filter = 'top') %>%
formatRound(columns = c("baseMean", "log2FoldChange", "lfcSE", "stat"), digits = 3) %>%
formatSignif(columns = c("pvalue", "padj"), digits = 3)
})
ma_plot_reac <- reactive({
de_table %>%
dplyr::mutate(sig = ifelse(padj < input$padj_filter & abs(log2FoldChange) > input$lfc_filter, "DE", "Not_DE")) %>% # >>>>>>>>>>>>>>>
ggplot(aes(x = baseMean, y = log2FoldChange, color = sig)) + geom_point() + scale_x_log10() +
scale_color_manual(name = "DE status", values = c("red", "grey")) +
xlab("baseMean (log scale)") + theme_bw()
}) %>%
bindEvent(input$de_filter, ignoreNULL = FALSE) # >>>>>>>>>>>>>>>
output$ma_plot = renderPlot({
ma_plot_reac()
})
volcano_plot_reac <- reactive({
de_table %>%
dplyr::mutate(sig = ifelse(padj < input$padj_filter & abs(log2FoldChange) > input$lfc_filter, "DE", "Not_DE")) %>% # >>>>>>>>>>>>>>>
ggplot(aes(x = log2FoldChange, y = negLog10_pval, color = sig)) + geom_point() +
scale_color_manual(name = "DE status", values = c("red", "grey")) + theme_bw()
}) %>%
bindEvent(input$de_filter, ignoreNULL = FALSE) # >>>>>>>>>>>>>>>
output$volcano_plot = renderPlot({
volcano_plot_reac() # >>>>>>>>>>>>>>>
})
}The datatable we are using from the DT package has a very useful functionality to enhance app interactivity. Rows can be selected and this informaiton is caputured in the app.
If we change the ‘selection’ argument to ‘single’ in the datatable function, then the user can click rows. Every time a row is clicked, shiny tracks this with a special input object. This object will always be the name of the table input with ’_rows_selected’ pasted onto the end.
In this simple app we print input$all_data_rows_selected and the gene in the selected row
ui_rowSelect <- page_fluid(
dataTableOutput(outputId = "all_data"),
textOutput("selected_row_info")
)
server_rowSelect <- function(input, output){
output$all_data = renderDataTable({
datatable(de_table,
selection = "single", #<<
filter = 'top')
})
selected_row <- reactive({
row_index <- input$all_data_rows_selected #<<
de_table[row_index, ]
})
output$selected_row_info <- renderText({
print(paste0("The selected gene is ", selected_row()$Symbol, " and the index of the selected row is ", input$all_data_rows_selected))
})
}Shiny also makes it easy to interact with plots. This cool feature can really enhance the user’s ability to get information quickly from a simple looking app.
The plotOutput function has a ‘click’ argument, and the string used (e.g. ‘plot_click’) becomes the name of an element in the input object that can be accessed in the server function. For example, plotOutput(“plot”, click = “plot_click”) will result in ‘input$plot_click’ being available in server.
In this case, ‘input$plot_click’ would be a list that contains the coordinates of the click. These coordinates can then be used in another Shiny function, nearPoints, which takes the clikc input object and the dataframe used for the plot, and returns the rows from the closest point (or points).
Here we show a table with the row of the clicked point in the server using the nearPoints function. The ‘threshold’ argument sets the distance (in y value space) from the point that is detected, and we also only return the closest point by setting ‘maxpoints’ to be one.
ui_pointClick <- page_fluid(
plotOutput("volcano_plot", click = "volcano_click"), #<<
tableOutput("selected_point_table"),
)
server_pointClick <- function(input, output){
volcano_plot_reac <- reactive({
ggplot(de_table, aes(x = log2FoldChange, y = negLog10_pval)) +
geom_point() +
theme_bw()
})
output$volcano_plot = renderPlot(volcano_plot_reac())
output$selected_point_table <- renderTable({
nearPoints(de_table, input$volcano_click, threshold = 20, maxpoints = 1) #<<
})
}A brush can be used in a similar way as the click. The ‘brush’ argument is set in plotOutput in the UI and we can then track the points that are in the selected area by rendering a table with the dataframe output from the brushedPoints function.
ui_pointBrush <- page_fluid(
plotOutput("volcano_plot", brush = "volcano_brush"), #<<
tableOutput("selected_brush_table")
)
server_pointBrush <- function(input, output){
volcano_plot_reac <- reactive({
ggplot(de_table, aes(x = log2FoldChange, y = negLog10_pval)) +
geom_point() +
theme_bw()
})
output$volcano_plot = renderPlot(volcano_plot_reac())
output$selected_brush_table <- renderTable({
brushedPoints(de_table, input$volcano_brush) #<<
})
}library(plotly)
ui_plotly <- page_fluid(
plotlyOutput("volcano_plotly"), #<<
)
server_plotly <- function(input, output){
volcano_plot_reac <- reactive({
ggplot(de_table, aes(x = log2FoldChange, y = negLog10_pval, text = Symbol)) +
geom_point() +
theme_bw()
})
output$volcano_plotly = renderPlotly(ggplotly(volcano_plot_reac())) #<<
}We can also pull out the row associated with the point that is clicked on when using plotly. Plotly has a function called event_data that returns a dataframe with the x and y values of the point that is highlighted when a cursor click occurs.
The plot and click event can be linked with the ‘source’ argument given to both the ggplotly and event_data funcitons. We can use the x and y values returned by event_data to get the row of our table that represented the point that was clicked on.
library(plotly)
ui_plotly <- page_fluid(
plotlyOutput("volcano_plotly"),
tableOutput("plotly_click_row")
)
server_plotly <- function(input, output){
volcano_plot_reac <- reactive({
ggplot(de_table, aes(x = log2FoldChange, y = negLog10_pval, text = Symbol)) + geom_point() + theme_bw()
})
output$volcano_plotly = renderPlotly(ggplotly(volcano_plot_reac(), source = "volcano_plot")) #<<
clicked_row <- reactive({
event <- event_data(event = "plotly_click", source = "volcano_plot") #<<
if(!is.null(event) > 0){
de_table %>% filter(log2FoldChange == event$x & negLog10_pval == event$y)
}
})
output$plotly_click_row <- renderTable({
clicked_row()
})
}Shiny makes it easy to download components of the app in the same way you would save any R object. To do this we use a special kind of button, called a downloadButton.
In the server the output objects are paired with a downloadHandler function. This is a special kind of server function that will take two arguments that are both functions. * The ‘filename’ argument takes no arguments and returns a string that will be the filename * The ‘content’ argument is a function that takes one argument named file that will be a temporary file path to write the file to, and the function contains code to generate and save the file. *Reactive values can be used inside of the ‘content’ function.
server_download <- function(input, output){
volcano_plot_reac <- reactive(ggplot(de_table, aes(x = log2FoldChange, y = negLog10_pval, text = Symbol)) + geom_point() + theme_bw())
output$volcano_plotly = renderPlotly(ggplotly(volcano_plot_reac(), source = "volcano_plot"))
output$download_volcano_plot <- downloadHandler( #<<
filename = function() { #<<
"volcanoplot.pdf" #<<
}, content = function(file) { #<<
ggsave(filename = file, plot = volcano_plot_reac()) #<<
} #<<
) #<<
}ui_newPlots <- page_navbar(
title = "RNAseq tools",
theme = custom_theme,
nav_panel(
title = "DE Analysis",
layout_sidebar(
sidebar = sidebar(
width = 300,
numericInput("padj_filter", label = "Cutoff for padj:", value = 0.05, min = 0, max = 1, step = 0.005),
numericInput("lfc_filter", label = "Cutoff for log2 FC:", value = 1, min = 0, step = 0.1),
actionButton("de_filter", "Apply filter")
),
layout_columns(
navset_card_tab(
title = "DE result tables",
nav_panel(card_header("DEGs"), dataTableOutput(outputId = "de_data")),
nav_panel(card_header("All genes"), dataTableOutput(outputId = "all_data"))
),
# >>>>>>>>>>>>>>>>>>>>>>>>
# change to plotly and add download buttons to each card
card(card_header("MA plot"),
plotlyOutput("ma_plot"),
downloadButton("download_ma_plot", "Download MA plot", style = "width:40%;")),
card(card_header("Volcano plot"),
plotlyOutput("volcano_plot"),
downloadButton("download_volcano_plot", "Download volcano plot", style = "width:40%;")),
# >>>>>>>>>>>>>>>>>>>>>>>>
col_widths = c(12,6,6), row_heights = c("750px", "500px")
)
)
),
nav_panel(title = "Next steps","The next step in our analysis will be..."),
nav_spacer(),
nav_menu(title = "Links",
align = "right",
nav_item(tags$a(shiny::icon("chart-simple"), "RU BRC - Learn more!", href = "https://rockefelleruniversity.github.io/",target = "_blank"))
)
)server_newPlots = function(input, output) {
# >>>>>>>>>>>>>>>>>>>>>>>>
output$download_ma_plot <- downloadHandler(
filename = function() {
"maplot.pdf"
},
content = function(file) {
ggsave(filename = file, plot = ma_plot_reac())
}
)
output$download_volcano_plot <- downloadHandler(
filename = function() {
"volcanoplot.pdf"
},
content = function(file) {
ggsave(filename = file, plot = volcano_plot_reac())
}
)
# >>>>>>>>>>>>>>>>>>>>>>>>
output$all_data = renderDataTable({
datatable(de_table,
filter = 'top') %>%
formatRound(columns = c("baseMean", "log2FoldChange", "lfcSE", "stat"), digits = 3) %>%
formatSignif(columns = c("pvalue", "padj"), digits = 3)
})
filtered_de <- reactive({
de_table %>%
dplyr::filter(padj < input$padj_filter & abs(log2FoldChange) > input$lfc_filter)
}) %>%
bindEvent(input$de_filter, ignoreNULL = FALSE)
output$de_data = renderDataTable({
datatable(filtered_de(),
selection = "single",
filter = 'top') %>%
formatRound(columns = c("baseMean", "log2FoldChange", "lfcSE", "stat"), digits = 3) %>%
formatSignif(columns = c("pvalue", "padj"), digits = 3)
})
ma_plot_reac <- reactive({
de_table %>%
dplyr::mutate(sig = ifelse(padj < input$padj_filter & abs(log2FoldChange) > input$lfc_filter, "DE", "Not_DE")) %>%
ggplot(aes(x = baseMean, y = log2FoldChange, color = sig, text = Symbol)) + geom_point() + scale_x_log10() +
scale_color_manual(name = "DE status", values = c("red", "grey")) +
xlab("baseMean (log scale)") + theme_bw()
}) %>%
bindEvent(input$de_filter, ignoreNULL = FALSE)
# >>>>>>>>>>>>>>>>>>>>>>>>
# use 'renderPlotly' and wrap plot in 'ggplotly'
output$ma_plot = renderPlotly({
ggplotly(ma_plot_reac())
})
# >>>>>>>>>>>>>>>>>>>>>>>>
volcano_plot_reac <- reactive({
de_table %>%
dplyr::mutate(sig = ifelse(padj < input$padj_filter & abs(log2FoldChange) > input$lfc_filter, "DE", "Not_DE")) %>%
ggplot(aes(x = log2FoldChange, y = negLog10_pval, color = sig, text = Symbol)) + geom_point() +
scale_color_manual(name = "DE status", values = c("red", "grey")) + theme_bw()
})
# >>>>>>>>>>>>>>>>>>>>>>>>
output$volcano_plot = renderPlotly({
ggplotly(volcano_plot_reac())
})
# >>>>>>>>>>>>>>>>>>>>>>>>
}Exercises for Session 2 are here